home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / qwik21.arc / QDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-12-09  |  11.5 KB  |  320 lines
  1. { Qdemo.pas - Demonstration program for Q screen utilities  ver 2.1, 12-07-86 }
  2. { Demo has been programmed for All Cards and any column mode.  If you want to }
  3. { try 40 column mode, remove the braces around line 53 and compile.           }
  4. {$I qwik21.inc}
  5.  
  6. type  BrdrRec = record                 { For Qbox procedure }
  7.                   TL,TH,TR,LV,RV,BL,BH,BR: string[1];
  8.                 end;
  9.  
  10. var Row,Rows,Col,Cols,Ctr,Step,Rstep,ColMax,
  11.     Count,Attrib,i,wait,CRTCols: integer;
  12.     HideCursor,OldCursor,Fgrnd,Bgrnd: integer;
  13.     BrdrAttr, WndwAttr: integer;
  14.     SavedBlock, PopUpBlock: array [1..4000] of byte;
  15.     BlkRow,BlkCol: byte;
  16.     Tattr: byte absolute Dseg:$0008;   { Location of Turbo's attribute }
  17.     CRTColumns: byte absolute $0040:$004A;  { Location of CRT columns }
  18.     ColL,ColR: array [1..3] of byte;
  19.     Strng,NumStr: String[75];
  20.     Data: array [1..9] of String[80];
  21.     Rnum:  Real;
  22.  
  23. const                                  { These are double lines for Qbox }
  24.     Border: BrdrRec =  (TL:'╔';TH:'═';TR:'╗';
  25.                         LV:'║';       RV:'║';
  26.                         BL:'╚';BH:'═';BR:'╝');
  27.  
  28. { Qbox is an application of Q screen utilities.  It can make fast pop up menus.
  29.   Together with Qstore, you can do several windows at one time.               }
  30. procedure Qbox (Row,Col,Rows,Cols: byte; WndwAttr,BrdrAttr: integer;
  31.                                                       Brdr: BrdrRec);
  32. begin
  33.   if (Rows>=2) and (Cols>=2) then
  34.   begin
  35.     with Brdr do
  36.     begin
  37.       QwriteV (Row       ,Col                     ,BrdrAttr,TL);
  38.       Qfill   (Row       ,Col+1     ,1     ,Cols-2,BrdrAttr,TH);
  39.       QwriteV (Row       ,Col+Cols-1              ,BrdrAttr,TR);
  40.       Qfill   (Row+1     ,Col       ,Rows-2,1     ,BrdrAttr,LV);
  41.       Qfill   (Row+1     ,Col+Cols-1,Rows-2,1     ,BrdrAttr,RV);
  42.       QwriteV (Row+Rows-1,Col                     ,BrdrAttr,BL);
  43.       Qfill   (Row+Rows-1,Col+1     ,1     ,Cols-2,BrdrAttr,BH);
  44.       QwriteV (Row+Rows-1,Col+Cols-1              ,BrdrAttr,BR);
  45.       Qfill   (Row+1     ,Col+1     ,Rows-2,Cols-2,WndwAttr,' ')
  46.     end
  47.   end
  48. end;
  49.  
  50. begin
  51. { --- Set up data --- }
  52.   Qinit;                     { << <<  Required intializing statement !! }
  53. { TextMode (C40); }          { Remove brackets for test of 40 column mode }
  54.   CRTCols:=CRTColumns;
  55.   Wait:= 500;
  56.   HideCursor:=8192;
  57.   Strng:= ' Q Screen Utilities ';
  58.   Data[1]:= '1';
  59.   Data[2]:= '22';
  60.   Data[3]:= '333';
  61.   Data[4]:= Strng;
  62.   Data[5]:= 'Odd  Length';
  63.   Data[6]:= 'Even  Length';
  64.   Data[7]:= '18 characters wide';
  65.   Data[8]:= '19 characters width';
  66.   Data[9]:= 'Margin to Margin width';
  67.  
  68. { --- Initial screen --- }
  69.   CursorChange (HideCursor, OldCursor);
  70.   Qfill    ( 1, 1,25,CRTCols,blue shl 4 + white,' ');      {  Clear Screen }
  71.   QwriteCV (11, 1,CRTCols,blue shl 4 + yellow, Strng);
  72.   QwriteC  (13, 1,CRTCols, -1,'Your screen is about to explode.');
  73.   QwriteC  (14, 1,CRTCols, -1,'Hold on to your seat ...');
  74.   Delay    (Wait*5);
  75.  
  76. { --- Explosion of Boxes --- }
  77.   Qfill    (11, 1, 4,CRTCols, -1,' ');          {  Clear Lines }
  78.   Qattr    ( 1, 1,25,CRTCols,LightGray shl 4);  {  Change screen attribute }
  79.   Ctr:=CRTCols div 2;
  80.   for step:=2 to Ctr-2 do
  81.   begin
  82.     if Step>24 then Rstep:=12 else Rstep:=Step shr 1;
  83.     for Count:=1 to 20 do
  84.     begin
  85.       Row:= 13 - Rstep + random(Rstep+2);
  86.       Rows:= Rstep;
  87.       Cols:= Rstep + Rstep + Rstep shr 2;
  88.       if step<=24 then Col:=Ctr-Cols+random(Cols+1)
  89.         else  Col:= Ctr - 1 - step + random(step+step-22);
  90.       Fgrnd:= random (16);
  91.       Bgrnd:= random (8);
  92.       if Bgrnd=Fgrnd then Fgrnd:=Fgrnd + 1;
  93.       Attrib:= (Bgrnd shl 4) + Fgrnd;
  94.       Qfill (Row,Col,Rows,Cols,Attrib,#178);
  95.     end
  96.   end;
  97.  
  98.   QfillC  (10, 1,CRTCols, 6,34,Red   shl 4,' ');
  99.   QfillC  (11, 1,CRTCols, 4,30,Brown shl 4,' ');
  100.   Tattr:= Red shl 4 + Yellow;
  101.   QwriteCV(12, 1,CRTCols,Tattr,Strng);
  102.   QwriteC (13, 1,CRTCols,Tattr,'    Version  2.1    ');
  103.  
  104.   { --- Save Screen for Page Demo --- }
  105.   if MaxPage>0 then
  106.   begin
  107.     QstoreToMem ( 1, 1,25,CRTCols,SavedBlock);
  108.     QwritePage  (1);
  109.     QstoreToScr ( 1, 1,25,CRTCols,SavedBlock);
  110.     QwritePage  (0);
  111.   end;
  112.   { --- End of Save Screen --- }
  113.   Delay   (Wait*4);
  114.   Tattr:= Blue shl 4 + white;
  115.   QwriteC ( 6, 1,CRTCols,Tattr,' Qwrite will write with new attributes ');
  116.   QwriteC ( 7, 1,CRTCols,Tattr,' that you specify direct to the screen.');
  117.   Delay   (Wait*6);
  118.   QwriteC (18, 1,CRTCols, -1,' Qwrite will also use existing attributes ');
  119.   QwriteC (19, 1,CRTCols, -1,'    when you do not even know or care.    ');
  120.                         { highlight the word 'existing' }
  121.   QattrC  (18, 6,CRTCols+5,1,10,LightRed shl 4 + white);
  122.   Delay   (wait*10);
  123.   QwriteC (21, 1,CRTCols,Tattr,' Say Goodbye to this screen. ');
  124.  
  125.   Delay   (wait*3);
  126.   { --- Disintigrate Screen --- }
  127.   for i:=1 to 5000 do
  128.   begin
  129.     row:=random(25)+1;
  130.     col:=random(CRTCols)+1;
  131.     qfill (row,col, 1, 1,Black,' ');
  132.   end;
  133.  
  134. { --- Qwrite with Str on Reals Demo --- }
  135.   Qfill   ( 1, 1,25,CRTCols,Yellow,' ');       {  Clear Screen }
  136.   QwriteC ( 2, 1,CRTCols, -1,'QwriteV with Turbo''s Str will write');
  137.   QwriteC ( 3, 1,CRTCols, -1,'reals and integers faster:');
  138.   Delay   (wait*7);
  139.   Rnum:=1.23E+05;
  140.   for col:=0 to CRTCols div 20 -1 do
  141.   for row:=5 to 24 do
  142.   begin
  143.     Rnum:=Rnum+1;
  144.     Str(Rnum:12,NumStr);
  145.     QwriteV (row,col*20+4, -1,NumStr);
  146.   end;
  147.   Delay (wait*12);
  148.  
  149. { --- Centering Demo --- }
  150.   Qfill   ( 1, 1,25,CRTCols,LightGray shl 4,' ');       {  Clear Screen }
  151.   QwriteC ( 2, 1,CRTCols, -1,'QwriteC and QwriteCV will automatically');
  152.   QwriteC ( 3, 1,CRTCols, -1,'center your data ...');
  153.   QwriteC ( 4, 1,CRTCols, -1,'(Odd breaks are shifted to the left.)');
  154.   Delay   (wait*6);
  155.  
  156.   { - Set up columns for varying column modes - }
  157.   ColL[2]:=1; ColR[2]:=CRTCols;
  158.   if CRTCols<80 then
  159.   begin
  160.     ColL[1]:=ColL[2]; ColL[3]:=CRTCols div 2;
  161.     ColR[1]:=ColR[2]; ColR[3]:=CRTCols div 2;
  162.   end
  163.   else
  164.   begin
  165.     ColL[1]:=3; ColR[1]:=26; ColL[3]:=CRTCols-14; ColR[3]:=CRTCols-14;
  166.   end;
  167.  
  168.   QwriteC ( 7,ColL[1],ColR[1], -1,'between margins ...');
  169.   Qbox    ( 8,(ColL[1]+ColR[1]) shr 1 -12,15,26,white,LightGray,Border);
  170.   Delay   (wait*3);
  171.   for row:=11 to 19 do
  172.     QwriteCV (row,ColL[1],ColR[1], -1, Data[row-10]);
  173.   Delay   (wait*5);
  174.  
  175.   QwriteC ( 7,ColL[2],ColR[2], -1,'between two columns ...');
  176.   QfillC  ( 9,ColL[2],ColR[2],13,24,Yellow,' ');     {  Clear window }
  177.   for row:= 9 to 21 do
  178.     QwriteC  (row,ColL[2],ColR[2], -1,'><');         {  Show two columns  }
  179.   Delay   (wait*3);
  180.   for row:=11 to 19 do
  181.     QwriteCV (row,ColL[2],ColR[2],LightRed, Data[row-10]);
  182.   Delay   (wait*5);
  183.  
  184.   QwriteC ( 7,ColL[3],ColR[3], -1,'or on a center line ...');
  185.   QfillC  ( 8,ColL[3],ColR[3],15,27,LightGray shl 4,' ');     {  Clear window }
  186.   for row:=09 to 21 do                 {  Show center line  }
  187.     QwriteC  (row,ColL[3],ColR[3],LightGray shl 4 + white,'|');
  188.   Delay   (wait*3);
  189.   for row:=11 to 19 do
  190.     QwriteCV (row,ColL[3],ColR[3], -1, Data[row-10]);
  191.   Delay   (wait*10);
  192.  
  193. { --- Qfill Demo --- }
  194.   Qfill   ( 1, 1,25,CRTCols,white,' ');       {  Clear Screen }
  195.   QwriteC ( 2, 1,CRTCols, -1,'Qfill as well as Qattr can fill');
  196.   QwriteC ( 3, 1,CRTCols, -1,'your screen in several ways.');
  197.   Delay   (wait*7);
  198.  
  199.   QwriteC ( 7, 1,CRTCols, -1,'by rows ...');
  200.   Delay   (wait*3);
  201.   for row:= 9 to 24 do
  202.     Qfill (row, 2, 1,CRTCols-2,9+row,Chr(row+56));
  203.   Delay   (wait*5);
  204.  
  205.   Qfill   ( 7, 1,19,CRTCols,white,' ');       {  Clear Lines }
  206.   QwriteC ( 7, 1,CRTCols, -1,'by columns ...');
  207.   Delay   (wait*3);
  208.   for col:=2 to CRTCols-2 do
  209.     Qfill ( 9,col,16,1,16+col,chr(col+63));
  210.   Delay   (wait*5);
  211.  
  212.   Qfill   ( 7, 1,19,CRTCols,white,' ');       {  Clear Lines }
  213.   QwriteC ( 7, 1,CRTCols, -1,'or by row-by-column blocks ...');
  214.   Delay   (wait*3);
  215.     Qfill ( 9,2,16,CRTCols-2,Blue shl 4 + Yellow,'!');
  216.   Delay   (wait*5);
  217.  
  218. { --- Qbox demo --- }
  219.   Qfill   ( 1, 1,25,CRTCols,LightGray shl 4,' ');       {  Clear Screen }
  220.   QwriteC ( 2, 1,CRTCols, -1,'Qbox is an application procedure made');
  221.   QwriteC ( 3, 1,CRTCols, -1,'from QwriteV and Qfill.  Together they');
  222.   QwriteC ( 4, 1,CRTCols, -1,'can make windows with borders easy.');
  223.   Delay   (wait*9);
  224.   QwriteC (14, 1,CRTCols, -1,'How about 100 of them? ... ');
  225.   Delay   (wait*4);
  226.   ColMax:=CRTCols-21;
  227.   for i:=1 to 100 do
  228.   begin
  229.     row:=random (10)+6;
  230.     col:=random (ColMax)+2;
  231.     BrdrAttr:=random (128);
  232.     WndwAttr:=random (128);
  233.     Qbox (row,col,10,20,BrdrAttr,WndwAttr,Border);
  234.   end;
  235.   Delay   (wait*10);
  236.  
  237. { --- Block Transfer and PopUp Demo --- }
  238.   Qfill   ( 1, 1,25,CRTCols,Yellow,'?');       {  Clear Screen }
  239.   QfillC  (10, 1,CRTCols, 6,40,Brown shl 4,' ');    {  Clear Block }
  240.   QwriteC (11, 1,CRTCols, -1,'Qstore will save and restore');
  241.   QwriteC (12, 1,CRTCols, -1,'Row-by-Column blocks on your display.');
  242.   QwriteC (13, 1,CRTCols, -1,'It is so fast, I have to slow it down');
  243.   QwriteC (14, 1,CRTCols, -1,'so you can see it.');
  244.     Delay (wait*11);
  245.     BlkRow:=8;
  246.     BlkCol:=CRTCols div 2 - 9;
  247.   QstoreToMem(BlkRow,BlkCol,10,20,SavedBlock);
  248.   { --- Make a Pop Up Menu --- }
  249.   Qbox (BlkRow,BlkCol,10,20,Blue shl 4 + Yellow,Blue shl 4 + Brown,Border);
  250.   QwriteC (BlkRow+4,BlkCol,BlkCol+20, -1,'Pop Up');
  251.   QwriteC (BlkRow+5,BlkCol,BlkCol+20, -1,'Menu');
  252.   { --- End of Pop Up Menu --- }
  253.   QstoreToMem(BlkRow,BlkCol,10,20,PopUpBlock);
  254.     Delay (wait*4);
  255.   ColMax:=CRTCols-20;
  256.   for i:=1 to 30 do
  257.   begin
  258.     Delay (Wait div 2);
  259.     QstoreToScr(BlkRow,BlkCol,10,20,SavedBlock);
  260.     BlkRow:=random(15)+1;
  261.     BlkCol:=random(ColMax)+1;
  262.     QstoreToMem(BlkRow,BlkCol,10,20,SavedBlock);
  263.     QstoreToScr(BlkRow,BlkCol,10,20,PopUpBlock);
  264.   end;
  265.  
  266. { --- Page Demo --- }
  267.   if MaxPage>0 then
  268.   begin
  269.     QviewPage  (1);
  270.     QwritePage (1);
  271.     Tattr:= Blue shl 4 + Yellow;
  272.     QwriteC (20, 1,CRTCols,Tattr,' Remember this page?  ');
  273.     QwriteC (21, 1,CRTCols,Tattr,' It wasn''t destroyed, but saved using ');
  274.     QwriteC (22, 1,CRTCols,Tattr,' Qstores and placed on a new page. ');
  275.     Delay (wait*14);
  276.     QwritePage (0);
  277.     QviewPage  (0);
  278.   end;
  279.  
  280. { --- Attribute Demo --- }
  281.   Qfill   ( 1, 1,25,CRTCols,green shl 4 + green,' ');    {  Clear Screen }
  282.   Tattr:= green shl 4 + white;
  283.   QwriteC ( 2, 1,CRTCols,Tattr,'Q Screen Utilities is hiding strings on');
  284.   QwriteC ( 3, 1,CRTCols,Tattr,'your screen ...');
  285.   Cols:=CRTCols div 20;
  286.   if Vmode=7 then Tattr:=0 else Tattr:= green shl 4 + green;
  287.   for col:=0 to Cols-1 do
  288.   for row:=5 to 20 do
  289.     QwriteV (row,20*col+1,Tattr,Strng);
  290.   Delay   (wait*8);
  291.  
  292.   Qfill   ( 2, 1, 2,CRTCols,-1,' ');        {  Clear Lines }
  293.   Tattr:= green shl 4 + white;
  294.   QwriteC ( 2, 1,CRTCols,Tattr,'Qattr can show them -');
  295.   QwriteC ( 3, 1,CRTCols,Tattr,'by merely changing the attribute!');
  296.   Delay   (wait*6);
  297.  
  298.   { --- Try using Turbo's color procedures this time --- }
  299.   TextColor (Black); TextBackground (Green);
  300.   Qattr   ( 5, 1,16,CRTCols,Tattr);         {  Reveal Data }
  301.   Delay   (wait*5);
  302.  
  303.   Qfill   ( 2, 1, 2,CRTCols,-1,' ');        {  Clear Lines }
  304.   TextColor (Yellow); TextBackground (Green);
  305.   QwriteC ( 2, 1,CRTCols,Tattr,'Or even just emphasize what''s seen ...');
  306.   for i:=1 to 500 do
  307.   begin
  308.     Row:= random(16) + 5;
  309.     Col:= random(Cols)*20+1;
  310.     Qattr (Row,Col, 1,20,46);
  311.     Delay (3);
  312.     Qattr (Row,Col, 1,20,32);
  313.   end;
  314.   for i:=1 to Cols do     {  Emphasize Data }
  315.     Qattr ( 5*i,(i-1)*20+1, 1,20,LightGreen shl 4 + Yellow);
  316.   QwriteC (24, 1,CRTCols,Tattr,' (c) 1986 James H. LeMay ');
  317.   GotoRC  (21, 1);
  318.   CursorChange (OldCursor, OldCursor);
  319. end.
  320.